home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
EDUCATE
/
TURKISH1.ARJ
/
TEACHER.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-09-10
|
9KB
|
345 lines
' Code by Turgut Kalfaoglu
' Elementary Turkish Teacher with incomplete lessons.
' If you like this program, PLEASE send $20 to:
' Turgut Kalfaoglu
' 1378 Sok, 8/10
' Alsancak, Izmir
REM $INCLUDE: 'bsedospc.bi'
DEFINT A-Z
DECLARE SUB GRABKEY (V$)
declare sub os2sound(freq,dur)
100 OPTION BASE 1
DIM TURK$(500), ENG$(500), FOUND%(500), SCR(2000)
110 CLS
RANDOMIZE TIMER
COLOR 3
PRINT " Turkish Tutor Version 0.9"
PRINT " A program by Turgut Kalfaoglu"
PRINT " 1378 Sok. 8/10, Izmir, Turkey"
PRINT
PRINT "Special Key assignments: See bottom of screen."
KEY ON
KEY 1, CHR$(153)
KEY 2, CHR$(154)
KEY 3, CHR$(143)
KEY 4, CHR$(128)
KEY 5, CHR$(36)
PRINT
COLOR 9
PRINT "Choose lesson number(s) -separated by commas&dashes- to begin:"
PRINT
COLOR 4
CLOSE 1
OPEN "TEACHER.DAT" FOR RANDOM AS 1 LEN = 34
FIELD #1, 2 AS LES.NO$, 16 AS WORD$, 16 AS CORR$
PR$ = ""
WHILE NOT EOF(1)
GET #1
IF VAL(LES.NO$) <> 0 THEN
IF INSTR(PR$, "\" + (LES.NO$) + "\") = 0 THEN PRINT LES.NO$, : PR$ = PR$ + "\" + LES.NO$ + "\"
END IF
WEND
COLOR 3
ASK.AGAIN:
LOCATE 20, 1, 1
PRINT "Other commands:"
PRINT
COLOR 31: PRINT "A"; : COLOR 11: PRINT "dd words,lessons ";
COLOR 31: PRINT "S"; : COLOR 11: PRINT "earch definition ";
COLOR 31: PRINT "H"; : COLOR 11: PRINT "elp ";
COLOR 31: PRINT "Q"; : COLOR 11: PRINT "uit ";
t$ = ""
AG:
CALL GRABKEY(Q$)
PRINT Q$;
IF (Q$ >= "0" AND Q$ <= "9") OR (Q$ = ",") OR Q$ = "-" THEN t$ = t$ + Q$: GOTO AG
A$ = t$
IF Q$ = "A" THEN GOSUB ADD: CLOSE : GOTO 100
IF Q$ = "S" THEN GOSUB SEARCH: CLOSE : GOTO 100
IF Q$ = "Q" THEN CLOSE : PRINT : LOCATE 24, 1: PRINT "Hope you had fun!": END
IF VAL(A$) = 0 THEN t$ = "": GOSUB EXPLAIN: GOTO 110
WHILE (INSTR(A$, "-")) 'resolving dashes
I = INSTR(A$, "-")
IF t > 0 THEN
L$ = LEFT$(A$, I - 1)
r$ = MID$(A$, I + 1)
FROM$ = ""
FOR t = LEN(L$) TO 1 STEP -1
t$ = MID$(L$, t, 1)
IF t$ < "0" OR t$ > "9" THEN EXIT FOR
FROM$ = t$ + FROM$
NEXT
FROM = VAL(FROM$)
L$ = LEFT$(L$, t)
FOR t = 1 TO LEN(r$)
t$ = MID$(r$, t, 1)
IF t$ < "0" OR t$ > "9" THEN EXIT FOR
NEXT
till = VAL(LEFT$(r$, t - 1))
r$ = MID$(r$, t)
IF till < FROM THEN SWAP till, FROM
n$ = ""
FOR t = FROM TO till
n$ = n$ + "," + MID$(STR$(t), 2)
NEXT
n$ = MID$(n$, 2)
A$ = L$ + n$ + r$
END IF 'does - exist here?
WEND
A$ = "," + A$ + ","
GET #1, 1
I = 1
COLOR 7
WHILE NOT EOF(1) AND I < 501
GET #1 'read a record
t$ = "," + RTRIM$(LES.NO$) + ","
IF INSTR(A$, t$) > 0 THEN
LOCATE 24, 1
PRINT "Loading lesson #"; LES.NO$; " ";
TURK$(I) = WORD$
ENG$(I) = CORR$ + LES.NO$
FOUND%(I) = 0
I = I + 1
END IF
WEND
COLOR 9
TOTAL.WORDS = I - 1
IF TOTAL.WORDS = 0 THEN 100
WORDS:
COLOR 9
QUEST = QUEST + 1
CLS
RN = INT(RND * 2) + 1
PRINT "What does this word mean in ";
IF RN = 2 THEN PRINT "Turkish?"; ELSE PRINT "English?";
DONE = 0
COUNTER = 0
WHILE COUNTER < 100 AND NOT DONE
Q = INT(RND * TOTAL.WORDS) + 1
IF FOUND%(Q) = 0 THEN DONE = -1
COUNTER = COUNTER + 1
WEND
FROM.LESSON = VAL(MID$(ENG$(Q), 17))
TMP$ = ENG$(Q)
ENG$(Q) = LEFT$(ENG$(Q), 16)
IF FROM.LESSON > 0 THEN PRINT " ( from lesson"; FROM.LESSON; " )" ELSE PRINT
IF RN = 1 THEN
ASKFOR$ = TURK$(Q)
ANSWER$ = ENG$(Q)
ELSE
ASKFOR$ = ENG$(Q)
ANSWER$ = TURK$(Q)
END IF
LOCATE 10, 25
COLOR 5
PRINT ASKFOR$
t = INSTR(ANSWER$, " ")
IF t > 0 THEN ANS$ = LEFT$(ANSWER$, t - 1) ELSE ANS$ = ANSWER$
FAUL = 0
AGAIN: LOCATE 12, 25
PRINT SPACE$(40);
LOCATE , 25
COLOR 7
INPUT "", GUESS$
GUESS$ = UCASE$(GUESS$)
COLOR 9
G = LEN(GUESS$)
IF G = 0 THEN FAUL = 5
IF ANS$ <> GUESS$ THEN
IF INSTR(ANS$, GUESS$ + "/") > 0 AND LEN(GUESS$) > 1 THEN GOTO NEWPAT
IF INSTR(ANS$, "/" + GUESS$) > 0 AND LEN(GUESS$) > 1 THEN GOTO NEWPAT
FAUL = FAUL + 1
IF FAUL < 3 THEN
LOCATE 24, 1
COLOR 31
PRINT "Try again!";
OS2SOUND 40, 40
COLOR 9
GOTO AGAIN
ELSE
LOCATE 24, 1
COLOR 6
PRINT "The word was:";
FOR KK = 80 TO 40 STEP -20
OS2SOUND KK, 40
NEXT KK
LOCATE 11, 27
PRINT "is";
LOCATE 12, 25
COLOR 7
PRINT ANS$; SPACE$(30);
COLOR 9
CALL GRABKEY(Q$)
END IF
ELSE
NEWPAT: LOCATE 12, 25
COLOR 7, 0
PRINT ANS$; SPACE$(30);
LOCATE 24, 1
COLOR 31
PRINT "Correct! ";
FOR KK = 1 TO 2
OS2SOUND 2500, 40
OS2SOUND 40, 40
NEXT
COLOR 9
SCORE = SCORE + 1
IF GEN < 5 THEN sleep 1
FOUND%(Q) = FOUND%(Q) + 1
END IF
ENG$(Q) = TMP$
LOCATE 20, 1
COLOR 3
IF GEN < 5 THEN GEN = GEN + 1: GOTO WORDS
PRINT "More words? "
GEN = 0
COLOR 9
AGAINST:
CALL GRABKEY(Q$)
IF Q$ = "Y" OR Q$ = "y" THEN GOTO WORDS
IF Q$ <> "N" AND Q$ <> "n" THEN GOTO AGAINST
FOR I = 0 TO 5
PRINT
NEXT
PRINT
COLOR 2
PRINT "Your score after "; QUEST; " questions is:"
PRINT
COLOR 12
SLEEP 2
GRADE = SCORE / QUEST * 100
IF GRADE > 89 THEN L$ = "A" ELSE IF GRADE > 79 THEN L$ = "B" ELSE IF GRADE > 69 THEN L$ = "C" ELSE IF GRADE > 59 THEN L$ = "D" ELSE L$ = "F"
L$ = "(" + L$ + ")"
PRINT USING "###.##\ \ \ \"; GRADE; "% correct"; L$
CALL GRABKEY(Q$)
CLOSE : GOTO 100
ADD:
CLS
PRINT
COLOR 3
PRINT "Locating free space..";
GET #1, 1
I = 1
WHILE NOT EOF(1)
GET #1, I
I = I + 1
WEND
I = I - 1
LOCATE , 1
PRINT SPACE$(70);
PRINT
PRINT "Enter lesson number to be entered: ";
INPUT LN
IF LN < 1 THEN RETURN
LSET LES.NO$ = MID$(STR$(LN), 2)
DONE = 0
WHILE NOT DONE
CLS
PRINT "Lesson number:"; LES.NO$
PRINT
PRINT "Enter word in Turkish, or blank return to save and exit."
INPUT W$
w$=ucase$(w$)
IF W$ = "" THEN DONE = -1
IF NOT DONE THEN
LSET WORD$ = W$
PRINT "Enter the corresponding English word for "; W$
INPUT W$
w$=ucase$(w$)
LSET CORR$ = W$
PUT #1, I
I = I + 1
END IF
WEND
RETURN
SEARCH:
CLS
LOCATE 5, 1
TITLE = 0
PRINT "Enter word to be searched, or blank RETURN to get back."
LOCATE 12, 25
COLOR 7
INPUT W$
w$=ucase$(w$)
COLOR 3
W = LEN(W$)
IF W$ > "" THEN
GET #1, 1
WHILE NOT EOF(1)
IF INSTR(WORD$, W$) > 0 THEN GOSUB ECHO
IF INSTR(CORR$, W$) > 0 THEN GOSUB ECHO
IF INSTR(LES.NO$, W$) > 0 THEN GOSUB ECHO
GET #1
WEND
GET #1, 1
PRINT "Search complete. Hit any key"
CALL GRABKEY(Q$)
END IF
RETURN
ECHO:
IF TITLE = 0 THEN PRINT "Lesson #", "Turkish ", "English ": TITLE = -1
PRINT LES.NO$, WORD$, CORR$
RETURN
EXPLAIN:
CLS
RESTORE INFO
READ Q$
IZ = 1
WHILE Q$ <> "*"
IZ = IZ + 1
LOCATE LROW + IZ, LCOL + (70 - LEN(Q$)) / 2
PRINT Q$;
READ Q$
WEND
CALL GRABKEY(Q$)
RETURN
INFO:
DATA "User-Supported Software"," "
DATA "Instructions:"
DATA "This program has a rather large dictionary that contains both"
DATA "Turkish and English equivalents of every word. You may choose"
DATA "to be drilled on one or more chapters. If you wish to be quizzed"
DATA "on just one chapter, enter the number of the chapter, then hit"
DATA "SPACE BAR to begin. If you wish to combine several chapters into"
DATA "the quiz, then separate the chapter numbers by commas or dashes."
DATA "The program will keep asking the questions that you missed"
DATA "previously, mixing them with the unasked questions."
DATA "(A)dd option allows you to enter new words, even chapters."
DATA "(S)earch provides a quick look-up for unknown words."
DATA " ","If you like this program please send $20 to the address"
DATA "shown on the title screen. Thank you for supporting shareware!"
DATA "*"
SUB GRABKEY (V$) STATIC
V$ = ""
LOCATE , , 1,1,30
WHILE V$ = ""
V$ = INKEY$
WEND
V$ = UCASE$(V$)
END SUB
sub OS2SOUND(FREQ,DUR) STATIC
x = DOSBEEP(FREQ,DUR)
END SUB